home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PAS_0793
/
NUMBASE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-08-01
|
7KB
|
204 lines
─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg : 305 of 322
From : Mark Lewis 1:3634/12.0 05 Jul 93 21:33
To : all
Subj : (1 of 2) number base conversions
────────────────────────────────────────────────────────────────────────────────
{
the following unit is based on original code by Lou Duchez. i have modified
Lou's original and based it on a character array. Function dec2base is still
very much like the code that Lou wrote. Function base2dec is all my code and
reverses the dec2base result. you can convert from one base to another by
converting to dec first... see sample program (2 of 2) for details...
BTW: no check is made for it, but we're only coded for Base 62. yes, 1A2 and
1a2 are two different numbers -=B-)
Original message quote to give appropraite credits...
(2547) Sat 12 Jun 93 7:50a
By: Lou Duchez
To: Robert Dekelbaum
Re: Decimal to hex conversion
=======================================================================
@MSGID: 1:157/200@fidonet.org 660ab59c
RD>does andbody know an easy way to convert a byte value from it's integer
RD> notation to hex notatation?
Well, thank you for this message. It finally got me off my keister (sp?) to
write a "decimal-to-hex" converter -- a project I'd been meaning to do, but
never got around to. (Technically, since I was in a seated position, I
remained on my keister the whole time, but you know what I mean). Actually,
the following is not just "decimal-to-hex" -- it's decimal-to-any-base-from-
2-to-36-converter (because base 1 and below doesn't make sense, and after
base 36 I run out of alphabet to represent "digits"). Here is NUBASE:
END OF QUOTE.
{---------------------------------------------------------------------------}
UNIT NUMBASE;
{ convert from almost any base to decimal and back again. }
{ Base 62 is the maximum that support is coded for }
interface
var
NUBase_err : boolean; { Global Unit Error var. }
{ True for String Overflow and }
{ Range Errors of characters and Base }
function dec2base(numin: longint; base, numplaces: byte): string;
function base2dec(numin: string; base : byte): longint;
implementation
const
DigitChars: array[0..61] of char =
'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
{---------------------------------------------------------------------------}
function dec2base(numin: longint; base, numplaces: byte): string;
var
tmpstr : string;
remainder : byte;
negatize : boolean;
begin
nubase_err := false; { set unit error boolean to false }
tmpstr := '';
negatize := (numin < 0); { record if it's a negative number }
if negatize then
numin := abs(numin); { convert to positive for calcs }
if base <> 10 then
begin
tmpstr[0] := char(numplaces); { set length of the output string }
while numplaces > 0 do { Loop: fills each space in string }
begin
remainder := numin mod base; { get next "digit" (under new base) }
{
if remainder > 9 then
tmpstr[numplaces] := char(remainder + 64 - 9) (* convert to letter *)
else
tmpstr[numplaces] := char(remainder + 48); (* use number as is *)
(*Replaced above 4 lines with below 1 to get position in const string*)
}
tmpstr[numplaces] := digitchars[remainder];
numin := numin div base; { reduce dividend for next "pass" }
numplaces := numplaces - 1; { go to "next" position in string }
end; { end of loop }
{ The following: if we've run out of room on the string, or if it's a
negative number and there's not enough space for the "minus" sign,
convert the output string to all asterisks. }
if (numin <> 0) or (negatize and (tmpstr[1] <> '0')) then
begin
for numplaces := 1 to byte(tmpstr[0]) do
tmpstr[numplaces] := '*';
nubase_err := true;
end;
end
else
begin
str(numin,tmpstr);
if length(tmpstr) < numplaces then
while length(tmpstr) < numplaces do
tmpstr := '0' + tmpstr
else
if (length(tmpstr) > numplaces) or (negatize and (tmpstr[1] <> '0')) then
begin
for numplaces := 1 to byte(tmpstr[0]) do
tmpstr[numplaces] := '*';
nubase_err := true;
end;
end;
{ add minus sign }
if negatize and (tmpstr[1] = '0') then
tmpstr[1] := '-';
dec2base := tmpstr;
end;
{---------------------------------------------------------------------------}
function base2dec(numin: string; base : byte): longint;
var tmpstr: string;
code : integer;
remainder: longint;
temp : longint;
power : longint;
numlen : byte;
negatize: boolean;
procedure breakdown;
function pwr(base : longint; exponent : byte) : longint;
var j : integer;
ptmp : longint;
begin { pwr }
if exponent > 1 then
begin
ptmp := base;
for j := 2 to exponent do
base := base * ptmp;
pwr := base;
end
else
case exponent of
0 : pwr := 0;
1 : pwr := base;
end;
end; { of pwr }
var x : byte;
begin { breakdown }
for x := numlen downto 1 do
begin
temp := 0;
power := 0;
temp := pos(numin[x],digitchars) - 1;
nubase_err := temp >= base;
if (not nubase_err) then
begin
power := pwr(base, (numlen - x));
if power = 0 then
remainder := remainder + temp
else
remainder := remainder + (temp * power);
end
else
exit;
end; { end of loop }
end; { of breakdown }
begin { base2dec }
nubase_err := false;
negatize := (numin[1] = '-'); { record if it's a negative number }
if negatize then
begin
numin := copy(numin,2,length(numin)); { convert to positive for calcs }
end;
numlen := length(numin);
remainder := 0;
tmpstr := '';
breakdown;
str(remainder,tmpstr);
if not nubase_err then
begin
{ add minus sign }
if negatize then
tmpstr := '-' + tmpstr;
end;
val(tmpstr,remainder,code);
base2dec := remainder;
end; { of base2dec }
begin
nubase_err := false;
end.
{End Of Unit NUMBase}